--  ---------------------------------------------------------------------------
--  @File: code_parser.adb
--
--  @Project: LiberAda
--  @Version: 1.0
--  @Created: 2009-10-19
--  @Author:  Ivan Bogicevic, Felix Krause
--
--  @Description:
--    TODO: Add Comment
--  @Implementation:
--    TODO: Add Comment
--
--  @Modifications:
--    +2009-10-19 IB: Initial release
--    +2011-04-06 FK: Removed unneccessary with clauses;
--                    Redefined Token_Type values;
--                    Simplified loop in Unify_Line_Ends
with Ada.Characters.Latin_1;

package body Code_Parser is

   --  ------------------------------------------------------------------------
   --  Redefinitions of Token_Type values to match with style guide
   --  ------------------------------------------------------------------------
   IDENTIFIER_TOKEN : Ada_Tokenizer.Token_Type
     renames Ada_Tokenizer.Identifier_T;
   DOT_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Dot_T;
   PROCEDURE_TOKEN : Ada_Tokenizer.Token_Type
     renames Ada_Tokenizer.Procedure_T;
   FUNCTION_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Function_T;
   COLON_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Colon_T;
   IS_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Is_T;
   RIGHT_PARENTHESIS_TOKEN : Ada_Tokenizer.Token_Type
     renames Ada_Tokenizer.Right_Parenthesis_T;
   PACKAGE_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Package_T;
   NEW_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.New_T;
   RENAMES_TOKEN : Ada_Tokenizer.Token_Type renames Ada_Tokenizer.Renames_T;
   SEMICOLON_TOKEN : Ada_Tokenizer.Token_Type
     renames Ada_Tokenizer.Semicolon_T;
   --  ------------------------------------------------------------------------
   --  End of redefinitions
   --  ------------------------------------------------------------------------


   --  ------------------------------------------------------------------------
   --  @Procedure Set_Filepath
   procedure Set_Filepath (Filepath : ASU.Unbounded_String) is
   begin
      --  When a new source file is read, we start from the beginning
      Clear;
      --  Remember the path to the ada source file
      Current_Filepath := Filepath;
   end Set_Filepath;

   --  ------------------------------------------------------------------------
   --  @Procedure Clear
   procedure Clear is
   begin
      --  Initially, we start to wait for normal symbols
      Parser_State := WAITING_FOR_SYMBOL;
      Current_Packagename := ASU.To_Unbounded_String ("");
   end Clear;

   --  ------------------------------------------------------------------------
   --  @Function Get_Current_Context
   function Get_Current_Context return ASU.Unbounded_String is
      Current_Context : ASU.Unbounded_String;
   begin
      Current_Context := Current_Packagename;
      return Current_Context;
   end Get_Current_Context;

   --  ------------------------------------------------------------------------
   --  @Function Token_To_Symbol
   function Token_To_Symbol
     (Kind   : in Ada_Tokenizer.Token_Type;
      Value  : in ASU.Unbounded_String)
      return Symbol.Symbol_Type is
      use Ada_Tokenizer;
      use ASU;
   begin
      --  Check the kind of the token
      if Parser_State = WAITING_FOR_SYMBOL and Kind = IDENTIFIER_TOKEN then
         --  Save the found symbol (which is not a procedure/function)
         Current_Symbol.Clear;
         Current_Symbol.Set_Filepath (Current_Filepath);
         Current_Symbol.Set_Packagename (Current_Packagename);
         Current_Symbol.Set_Name (Value);
         Parser_State := WAITING_FOR_DOT;
      elsif Parser_State = WAITING_FOR_DOT and Kind = DOT_TOKEN then
         --  A symbol can consist of several identifiers, separated by a dot
         --  (e.g. "Ada.Text_IO")
         Parser_State := WAITING_FOR_ANNEX;
      elsif Parser_State = WAITING_FOR_ANNEX and Kind = IDENTIFIER_TOKEN then
         --  After the dot within a compound symbol, we found the next part
         --  (e.g. "Text_IO" in "Ada.Text_IO")
         Current_Symbol.Set_Name (Current_Symbol.Get_Name & "." & Value);
         Parser_State := WAITING_FOR_DOT;
      elsif ((Parser_State = WAITING_FOR_DOT) and (Kind /= DOT_TOKEN)) or
         ((Parser_State = WAITING_FOR_ANNEX) and (Kind /= IDENTIFIER_TOKEN))
      then
         --  The symbol is not compound or all compound parts of a symbol were
         --  read in, so return the whole symbol
         Parser_State := WAITING_FOR_SYMBOL;
         Current_Symbol.Set_Kind (Symbol.UNKNOWN_T);
         return Current_Symbol;
      elsif Parser_State = WAITING_FOR_SYMBOL
         and (Kind = PROCEDURE_TOKEN or Kind = FUNCTION_TOKEN)
      then
         --  Trigger word "Procedure" or "Function" has been found,
         --  the next token which is an identifier will be its name
         Parser_State := WAITING_FOR_PROCEDURE_OR_FUNCTION_NAME;
      elsif Parser_State = WAITING_FOR_PROCEDURE_OR_FUNCTION_NAME
         and Kind = IDENTIFIER_TOKEN
      then
         --  Current identifier is the name of the procedure/function
         Current_Symbol.Clear;
         Current_Symbol.Set_Name (Value);
         Parser_State := WAITING_FOR_COLON;
      elsif Parser_State = WAITING_FOR_COLON and Kind = COLON_TOKEN then
         --  A colon separates the procedure/function name from
         --  its parameters and its types
         Parser_State := WAITING_FOR_PARAMETERTYPE;
      elsif Parser_State = WAITING_FOR_PARAMETERTYPE
         and Kind = IDENTIFIER_TOKEN
      then
         --  Type of a parameter of the procedure/function found
         Current_Symbol.Add_Parametertype (Value);
         Parser_State := WAITING_FOR_COLON;
      elsif Parser_State = WAITING_FOR_COLON and Kind = DOT_TOKEN then
         --  Instead of a colon, we found a point, so the Parametertype is
         --  compound (e.g. Ada.Strings.Unbounded_String)
         Parser_State := WAITING_FOR_PARAM_ANNEX;
      elsif Parser_State = WAITING_FOR_PARAM_ANNEX and
        Kind = IDENTIFIER_TOKEN then
         --  This is the next part of the compound parametertype (e.g.
         --  "Strings" in "Ada.Strings.Unbounded_String")
         Current_Symbol.Extend_Last_Parametertype ("." & Value);
         Parser_State := WAITING_FOR_COLON;
      elsif Parser_State = WAITING_FOR_PARAM_ANNEX
         and Kind /= IDENTIFIER_TOKEN
      then
         --  This should not happen, we expected to get another part of the
         --  compund parametertype, but we got something other
         Parser_State := WAITING_FOR_PARAMETERTYPE;
      elsif Parser_State = WAITING_FOR_COLON
         and (Kind = IS_TOKEN or Kind = RIGHT_PARENTHESIS_TOKEN)
      then
         --  Trigger word "is" or ")" shows that we have all parameters, so
         --  return the whole symbol (which is a procedure or function)
         Current_Symbol.Set_Filepath (Current_Filepath);
         Current_Symbol.Set_Packagename (Current_Packagename);
         Current_Symbol.Set_Kind (Symbol.FUNCTION_AND_PROCEDURE_T);
         Parser_State := WAITING_FOR_SYMBOL;
         return Current_Symbol;
      elsif Parser_State = WAITING_FOR_SYMBOL and Kind = PACKAGE_TOKEN then
         --  Trigger word "Package" has been found, the next token which is an
         --  identifier is a potential name of the package
         Parser_State := WAITING_FOR_PACKAGE_NAME;
      elsif Parser_State = WAITING_FOR_PACKAGE_NAME
         and Kind = IDENTIFIER_TOKEN
      then
         --  Current identifier could be the name of the package
         Current_Packagename_Candidate := Value;
         Parser_State := WAITING_FOR_IS_OR_RENAMES;
      elsif Parser_State = WAITING_FOR_IS_OR_RENAMES and Kind = IS_TOKEN then
         --  Trigger word "is" has been found
         Parser_State := WAITING_FOR_NEW;
      elsif Parser_State = WAITING_FOR_NEW and Kind = NEW_TOKEN then
         --  Found "new" after "is", e.g. in case of "package xy is new ..."
         Parser_State := IGNORE_ALL_UNTIL_SEMICOLON;
      elsif Parser_State = WAITING_FOR_NEW and Kind /= NEW_TOKEN then
         --  Standard case: only "is", e.g. in case of "package x is ..."
         Current_Packagename := Current_Packagename_Candidate;
         Parser_State := WAITING_FOR_SYMBOL;
      elsif Parser_State = WAITING_FOR_IS_OR_RENAMES and
        Kind = RENAMES_TOKEN then
         --  Trigger word "renames" found, e.g. "package x renames y"
         Parser_State := IGNORE_ALL_UNTIL_SEMICOLON;
      elsif Parser_State = IGNORE_ALL_UNTIL_SEMICOLON
         and Kind = SEMICOLON_TOKEN
      then
         --  Currently ignored part ends (due to a found semicolon)
         Parser_State := WAITING_FOR_SYMBOL;
      end if;
      --  No symbol or not all of its information has been collected yet
      Current_Symbol.Set_Kind (Symbol.EMPTY_T);
      return Current_Symbol;
   end Token_To_Symbol;

   --  ------------------------------------------------------------------------
   --  @Function Unify_Line_Ends
   function Unify_Line_Ends (Token_Value : ASU.Unbounded_String)
      return ASU.Unbounded_String is

      use Ada.Characters.Latin_1;
      use ASU;

      Unified_Str : Unbounded_String := To_Unbounded_String ("");

      Consumed_CR : Boolean := False;
      Cur_Element : Character;

   begin
      for Char_Itr in 1 .. Length (Token_Value) loop
         Cur_Element := Element (Token_Value, Char_Itr);
         if Cur_Element = CR then
            --  Exchange CR for a LF character
            Append (Unified_Str, LF);
            Consumed_CR := True;
         elsif Cur_Element = LF and Consumed_CR then
            --  "CR LF" has been read. CR was already transformed into LF,
            --  so skip this LF.
            Consumed_CR := False;
         else
            Append (Unified_Str, Cur_Element);
            Consumed_CR := False;
         end if;
      end loop;
      return Unified_Str;
   end Unify_Line_Ends;

end Code_Parser;
